home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tools / istan / ANLIB5.MAC.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  62.0 KB  |  1,514 lines
  1. C---------------------------------------------------------
  2. C    TOOLPACK/1    Release: 2.3
  3. C---------------------------------------------------------
  4. C---------------------------------------------------------
  5. C    TOOLPACK/1    Release: 2.3
  6. C---------------------------------------------------------
  7. C ----------------------------------------------------------------------
  8. C
  9. C       P R O C E S   -   Determine current statement segmentation and
  10. C                         instrumentation and create output to
  11. C                         statement type summary file, annotated listing
  12. C                         and temporary instrumented program file.
  13. C
  14.  
  15.         SUBROUTINE PROCES
  16.  
  17. C---------------------------------------------------------
  18. C    TOOLPACK/1    Release: 2.3
  19. C---------------------------------------------------------
  20. C                  LOGICAL VARIABLES
  21.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  22.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  23.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  24.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  25.      *         TREEG
  26.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  27.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  28.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  29.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  30.  
  31.         SAVE /LOGIC/
  32.  
  33. C---------------------------------------------------------
  34. C    TOOLPACK/1    Release: 2.3
  35. C---------------------------------------------------------
  36. C                  CONTROL VARIABLES
  37.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  38.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  39.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  40.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  41.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  42.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  43.      *         NSTMG,       NTREEG,      NTYPEG
  44.  
  45.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  46.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  47.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  48.      +          NTREEG,NTYPEG
  49.  
  50.         SAVE /CNTRLC/
  51.  
  52. C---------------------------------------------------------
  53. C    TOOLPACK/1    Release: 2.3
  54. C---------------------------------------------------------
  55. C                  KEYWORD ID VARIABLES
  56.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  57.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  58.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  59.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  60.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  61.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  62.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  63.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  64.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  65.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  66.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  67.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  68.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  69.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  70.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  71.      *         LLINEG,      LSTMTG
  72.  
  73.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  74.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  75.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  76.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  77.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  78.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  79.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  80.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  81.         INTEGER KUFUNG,KSUBRG
  82.  
  83.         SAVE /KEYSC/
  84.  
  85. C---------------------------------------------------------
  86. C    TOOLPACK/1    Release: 2.3
  87. C---------------------------------------------------------
  88. C                  MAIN INTEGER STORAGE ARRAYS
  89. C MAXLBG = Maximum number of DO statement labels per routine
  90.         INTEGER MAXLBG
  91.         PARAMETER(MAXLBG=100)
  92.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  93.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  94.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  95.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  96.      +          KEXECG,LABG,KTOKG
  97.         SAVE /WORKC/
  98. C---------------------------------------------------------
  99. C    TOOLPACK/1    Release: 2.3
  100. C---------------------------------------------------------
  101.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  102.      +                MAXICH
  103.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  104.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  105.      +          MAXICH
  106.  
  107.         SAVE /TOKENS/
  108.  
  109. C
  110. C TOKTYP = array of token types for current statement
  111. C TOKLEN = parallel array of lengths of associated text strings
  112. C TXTPTR = parallel array of pointers into ISTMG character array of text
  113. C TOKEN = Current token number within statement being processed
  114. C NTOKSS = Number of tokens in statement
  115. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  116. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  117. C MAXICH = Last character used in ISTTXT array
  118. C
  119. C---------------------------------------------------------
  120. C    TOOLPACK/1    Release: 2.3
  121. C---------------------------------------------------------
  122. C Option Settings
  123.         COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
  124.      +                 MTREQG,TIEG,ITRUNG
  125.  
  126.         INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
  127.      +          ITRUNG
  128.         LOGICAL TIEG
  129.  
  130.         SAVE /OPTSC/
  131.  
  132.  
  133. C If previous type = END, start new routine.
  134.         IF (LTYPEG.EQ.KENDG) CALL INITRS
  135. C Insert pass1 common block marker in scratch file
  136.         IF (.NOT.INSRTG) CALL INSRTS
  137. C Is statement executable?
  138.         IF (KEXECG(ITYPEG).EQ.1) THEN
  139. C First executable gets specially treated
  140.             IF (.NOT. EXECG) CALL EXECS
  141. C Get and check statement label
  142.             CALL LABCKS
  143.         ELSE
  144. C Ignore labels on unexecutable statements
  145.             LABFLG = 0
  146.         END IF
  147. C Process statement by type
  148.         IF (BLKDTG .AND. ITYPEG.NE.KENDG) THEN
  149. C Current routine is BLOCK DATA
  150.             SEGMTG = .FALSE.
  151.             CALL OUTS
  152.         ELSE IF (ITYPEG.EQ.KLIFG) THEN
  153. C Logical IF. Special instrumentation and look for function calls.
  154.             CALL PLIFS
  155.         ELSE IF (ITYPEG.EQ.KELSFG) THEN
  156. C ELSE IF. Special instrumentation.
  157.             CALL PELSFS
  158.         ELSE IF (ITYPEG .EQ. KELSEG  .OR.  ITYPEG .EQ. KENDIG) THEN
  159. C ELSE/END IF. Instrument after but include in count for next segment.
  160.             CALL SEGMTS(.TRUE.)
  161.             CALL OUTANS(NMSEG)
  162.             CALL INSOUT
  163.             CALL OUTSGS(NMSEG)
  164.             SEGMTG = .FALSE.
  165.         ELSE IF (ITYPEG.EQ.KBACKG .OR. ITYPEG.EQ.KCLOSG .OR.
  166.      +           ITYPEG.EQ.KENDFG .OR. ITYPEG.EQ.KINQRG .OR.
  167.      +           ITYPEG.EQ.KOPENG .OR. ITYPEG.EQ.KREADG .OR.
  168.      +           ITYPEG.EQ.KWINDG .OR. ITYPEG.EQ.KWRITG) THEN
  169. C I/O. Look for END= or ERR=.
  170.             CALL PIOS
  171.         ELSE IF (ITYPEG.EQ.KCALLG) THEN
  172. C CALL. Look for externals and alternate returns.
  173.             CALL PCALLS
  174.         ELSE IF (ITYPEG.EQ.KDOG) THEN
  175. C DO. Pick up ending label.
  176.             CALL PDOS
  177.         ELSE IF (ITYPEG.EQ.KSTOPG) THEN
  178. C STOP. Special instrumentation for terminators.
  179.             CALL PSTOPS
  180.         ELSE IF (ITYPEG.EQ.KENDG) THEN
  181. C END. Check for routine termination and summarize routine for
  182. c      statement type summary file.
  183.             CALL PENDS
  184.         ELSE IF (ITYPEG.EQ.KCHARG .OR. ITYPEG.EQ.KCOMNG .OR.
  185.      +           ITYPEG.EQ.KCMPXG .OR. ITYPEG.EQ.KDIMNG .OR.
  186.      +           ITYPEG.EQ.KDBLEG .OR. ITYPEG.EQ.KINTEG .OR.
  187.      +           ITYPEG.EQ.KLOGCG .OR. ITYPEG.EQ.KREALG) THEN
  188. C Specification. Look for dimensioned variables.
  189.             CALL PDIMNS
  190.         ELSE IF (ITYPEG.EQ.KNTRYG) THEN
  191. C ENTRY. Special instrumentation.
  192.             CALL PNTRYS
  193.         ELSE IF (ITYPEG.EQ.KCGOG) THEN
  194. C Computed GOTO. Special instrumentation.
  195.             CALL PCGOS(NTOKG-1,NTOKG)
  196.         ELSE IF (ITYPEG.EQ.KAIFG) THEN
  197. C Arithmetic IF. Special instrumentation.
  198.             CALL PAIFS(NTOKG,NTOK2G)
  199.         ELSE
  200. C Other types just output
  201.             CALL OUTS
  202.             IF (KEXECG(ITYPEG).EQ.1) SEGMTG = .FALSE.
  203.         END IF
  204.  
  205.         END
  206. C ----------------------------------------------------------------------
  207. C
  208. C       P S T O P S   -   Process STOP statements
  209. C
  210.  
  211.         SUBROUTINE PSTOPS
  212.  
  213. C---------------------------------------------------------
  214. C    TOOLPACK/1    Release: 2.3
  215. C---------------------------------------------------------
  216. C                  CONTROL VARIABLES
  217.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  218.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  219.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  220.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  221.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  222.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  223.      *         NSTMG,       NTREEG,      NTYPEG
  224.  
  225.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  226.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  227.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  228.      +          NTREEG,NTYPEG
  229.  
  230.         SAVE /CNTRLC/
  231.  
  232. C---------------------------------------------------------
  233. C    TOOLPACK/1    Release: 2.3
  234. C---------------------------------------------------------
  235.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  236.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  237.  
  238.         SAVE /IO/
  239.  
  240. C---------------------------------------------------------
  241. C    TOOLPACK/1    Release: 2.3
  242. C---------------------------------------------------------
  243. C                  LOGICAL VARIABLES
  244.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  245.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  246.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  247.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  248.      *         TREEG
  249.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  250.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  251.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  252.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  253.  
  254.         SAVE /LOGIC/
  255.  
  256. C---------------------------------------------------------
  257. C    TOOLPACK/1    Release: 2.3
  258. C---------------------------------------------------------
  259.         COMMON/ANVNAM/VNAMEG
  260.         CHARACTER*5 VNAMEG
  261.         SAVE/ANVNAM/
  262.  
  263.         IF (SEGMTG) THEN
  264. C Start segment and output annotated statement
  265.             CALL OUTSGS(NMSEG)
  266.             CALL OUTANS(NMSEG)
  267.         ELSE
  268. C Output un-annotated statement
  269.             CALL OUTANS(0)
  270.         END IF
  271. C Output call to wrapup routine instead of 'STOP'
  272.         CALL OUTMSG('      CALL R'//VNAMEG,IODSCR)
  273.         STOPG = .TRUE.
  274.         SEGMTG = .FALSE.
  275.  
  276.         END
  277. C ----------------------------------------------------------------------
  278. C
  279. C       R D A S   -   Build an assertion statement
  280. C
  281.  
  282.         SUBROUTINE RDAS
  283.  
  284. C---------------------------------------------------------
  285. C    TOOLPACK/1    Release: 2.3
  286. C---------------------------------------------------------
  287. C Character variables and arrays, except for dictionaries & VNAMEG
  288.         INTEGER MAXCMG
  289.         PARAMETER(MAXCMG=30)
  290.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  291.  
  292.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  293.         CHARACTER*6 NAMEG
  294.         CHARACTER*72 ICOMG(MAXCMG)
  295.  
  296.         SAVE /CHARC/
  297. C---------------------------------------------------------
  298. C    TOOLPACK/1    Release: 2.3
  299. C---------------------------------------------------------
  300. C                  LOGICAL VARIABLES
  301.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  302.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  303.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  304.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  305.      *         TREEG
  306.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  307.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  308.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  309.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  310.  
  311.         SAVE /LOGIC/
  312.  
  313. C---------------------------------------------------------
  314. C    TOOLPACK/1    Release: 2.3
  315. C---------------------------------------------------------
  316. C                  CONTROL VARIABLES
  317.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  318.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  319.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  320.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  321.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  322.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  323.      *         NSTMG,       NTREEG,      NTYPEG
  324.  
  325.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  326.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  327.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  328.      +          NTREEG,NTYPEG
  329.  
  330.         SAVE /CNTRLC/
  331.  
  332. C---------------------------------------------------------
  333. C    TOOLPACK/1    Release: 2.4
  334. C---------------------------------------------------------
  335. C
  336. C  TKLAST = LAST TOKEN NUMBER
  337. C
  338.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  339.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  340.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  341.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  342.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  343.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  344.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  345.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  346.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  347.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  348.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  349.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  350.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  351.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  352.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  353.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  354.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  355.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  356.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  357.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  358.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  359.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  360.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  361.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  362.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  363.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  364.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  365.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  366.  
  367. C---------------------------------------------------------
  368. C    TOOLPACK/1    Release: 2.3
  369. C---------------------------------------------------------
  370.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  371.      +                MAXICH
  372.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  373.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  374.      +          MAXICH
  375.  
  376.         SAVE /TOKENS/
  377.  
  378. C
  379. C TOKTYP = array of token types for current statement
  380. C TOKLEN = parallel array of lengths of associated text strings
  381. C TXTPTR = parallel array of pointers into ISTMG character array of text
  382. C TOKEN = Current token number within statement being processed
  383. C NTOKSS = Number of tokens in statement
  384. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  385. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  386. C MAXICH = Last character used in ISTTXT array
  387. C
  388.  
  389.         INTEGER L,ICOL,NULL
  390.         CHARACTER*72 CARD
  391.         EQUIVALENCE (CARD,ICARDG)
  392.  
  393.         INTRINSIC INDEX
  394.  
  395. *$AS$ (ASSRTG)
  396. C Dump comment buffer to listing
  397.         CALL DMPCMS
  398. C Store first part of first assertion card
  399.         ISTMG(1) = '*'
  400.         NSTMG = 1
  401. C Is assertion within 8 card maximum?
  402.   100   IF (NSTMG.LT.569) THEN
  403. C Pick up this card
  404.             ICOL=INDEX(CARD,'$')
  405.             ICOL=ICOL+INDEX(CARD(ICOL+1:72),'$')
  406.             CALL CCOPY(ICARDG(ICOL+1),72-ICOL,ISTMG(NSTMG+1))
  407.             NSTMG=NSTMG+72-ICOL
  408. C See if assertion complete yet
  409.             CALL BALPRS(1,ICOL)
  410.             IF (ICOL.NE.0) THEN
  411. C Assertion complete.
  412.             ELSE
  413. C Assertion incomplete. Keep going if possible.
  414.                 CALL READTK
  415.                 IF (.NOT.IEOFG .AND. TOKTYP(NTOKSS).EQ.TCMMNT) THEN
  416. C Next card ok. Keep building this assertion.
  417.                     GOTO 100
  418.                 ELSE
  419. C Current assertion bad (no end found).
  420.                     CALL ERRORS(5)
  421.                     CALL BADAS
  422.                 END IF
  423.             END IF
  424.         ELSE
  425. C Current assertion bad (too long).
  426.             CALL ERRORS(6)
  427.             CALL BADAS
  428. C Save last card of long assertion.
  429. C Get token for next cycle
  430.             CALL COMNTS(NULL)
  431.             CALL READTK
  432.         END IF
  433.  
  434.         END
  435. C ----------------------------------------------------------------------
  436. C
  437. C       R D O N E S   -   Summarize current routine on statement type
  438. C                         summary file
  439. C
  440.  
  441.         SUBROUTINE RDONES
  442.  
  443. C---------------------------------------------------------
  444. C    TOOLPACK/1    Release: 2.3
  445. C---------------------------------------------------------
  446. C                  CONTROL VARIABLES
  447.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  448.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  449.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  450.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  451.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  452.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  453.      *         NSTMG,       NTREEG,      NTYPEG
  454.  
  455.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  456.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  457.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  458.      +          NTREEG,NTYPEG
  459.  
  460.         SAVE /CNTRLC/
  461.  
  462. C---------------------------------------------------------
  463. C    TOOLPACK/1    Release: 2.3
  464. C---------------------------------------------------------
  465. C                  LOGICAL VARIABLES
  466.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  467.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  468.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  469.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  470.      *         TREEG
  471.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  472.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  473.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  474.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  475.  
  476.         SAVE /LOGIC/
  477.  
  478. C---------------------------------------------------------
  479. C    TOOLPACK/1    Release: 2.3
  480. C---------------------------------------------------------
  481. C                  ROUTINE INSTRUMENTATION FLAGS
  482.       COMMON / INSTC   /    INST1G,      INST2G,      INST3G
  483.  
  484.         INTEGER INST1G,INST2G,INST3G
  485.  
  486.         SAVE /INSTC/
  487.  
  488. C---------------------------------------------------------
  489. C    TOOLPACK/1    Release: 2.3
  490. C---------------------------------------------------------
  491. C                  KEYWORD ID VARIABLES
  492.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  493.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  494.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  495.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  496.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  497.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  498.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  499.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  500.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  501.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  502.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  503.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  504.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  505.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  506.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  507.      *         LLINEG,      LSTMTG
  508.  
  509.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  510.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  511.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  512.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  513.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  514.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  515.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  516.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  517.         INTEGER KUFUNG,KSUBRG
  518.  
  519.         SAVE /KEYSC/
  520.  
  521. C---------------------------------------------------------
  522. C    TOOLPACK/1    Release: 2.3
  523. C---------------------------------------------------------
  524. C                  MAIN INTEGER STORAGE ARRAYS
  525. C MAXLBG = Maximum number of DO statement labels per routine
  526.         INTEGER MAXLBG
  527.         PARAMETER(MAXLBG=100)
  528.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  529.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  530.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  531.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  532.      +          KEXECG,LABG,KTOKG
  533.         SAVE /WORKC/
  534. C---------------------------------------------------------
  535. C    TOOLPACK/1    Release: 2.3
  536. C---------------------------------------------------------
  537.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  538.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  539.  
  540.         SAVE /IO/
  541.  
  542.  
  543.         INTEGER L
  544.  
  545.         EXTERNAL ZMESS,PUTCH
  546.  
  547. C Output summary for last segment in routine
  548.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) + 1
  549.         CALL SGSUMS
  550.         ISCNTG(ITYPEG) = ISCNTG(ITYPEG) - 1
  551. C Count tokens following 'END' with next routine unless end of file
  552. C encountered.
  553.         IRCNTG(ITYPEG) = IRCNTG(ITYPEG) + 1
  554.         IF (.NOT.IEOFG) THEN
  555.             IF (NCOMG .GT. 0) THEN
  556.                 IRCNTG(LCMNTG) = IRCNTG(LCMNTG) - NCOMG
  557.                 IRCNTG(LLINEG) = IRCNTG(LLINEG) - NCOMG
  558.             END IF
  559.         END IF
  560. C Output record marking end of segment summaries
  561.         CALL ZMESS('**',IODSTS)
  562. C Output routine summary record
  563.         DO 50 L=1,NTYPEG
  564.             CALL OUTZFI(IRCNTG(L),5,IODSTS)
  565.             IF (MOD(L,16).EQ.0) CALL PUTCH(10,IODSTS)
  566.  50     CONTINUE
  567.         CALL PUTCH(10,IODSTS)
  568. C Set routine counts for next routine.
  569. C Include counts for comments and first ordinary token following 'END'
  570.         DO 100 L=1,NTYPEG
  571.   100      IRCNTG(L) = 0
  572.         IRCNTG(LCMNTG) = NCOMG
  573.         IRCNTG(LLINEG) = NCOMG
  574.         IRCNTG(ITYPEG) = IRCNTG(ITYPEG) - 1
  575. C Save data on special function use for this routine
  576.         INSTG(NCRTNG) = 4*INST1G + 2*INST2G + INST3G
  577.         INST1G = 0
  578.         INST2G = 0
  579.         INST3G = 0
  580.  
  581.         END
  582. C ----------------------------------------------------------------------
  583. C
  584. C       R D S S   -   Build a normal statement
  585.  
  586.         SUBROUTINE RDSS
  587.  
  588. C---------------------------------------------------------
  589. C    TOOLPACK/1    Release: 2.3
  590. C---------------------------------------------------------
  591. C Character variables and arrays, except for dictionaries & VNAMEG
  592.         INTEGER MAXCMG
  593.         PARAMETER(MAXCMG=30)
  594.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  595.  
  596.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  597.         CHARACTER*6 NAMEG
  598.         CHARACTER*72 ICOMG(MAXCMG)
  599.  
  600.         SAVE /CHARC/
  601. C---------------------------------------------------------
  602. C    TOOLPACK/1    Release: 2.3
  603. C---------------------------------------------------------
  604. C                  LOGICAL VARIABLES
  605.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  606.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  607.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  608.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  609.      *         TREEG
  610.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  611.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  612.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  613.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  614.  
  615.         SAVE /LOGIC/
  616.  
  617. C---------------------------------------------------------
  618. C    TOOLPACK/1    Release: 2.3
  619. C---------------------------------------------------------
  620.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  621.      +                MAXICH
  622.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  623.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  624.      +          MAXICH
  625.  
  626.         SAVE /TOKENS/
  627.  
  628. C
  629. C TOKTYP = array of token types for current statement
  630. C TOKLEN = parallel array of lengths of associated text strings
  631. C TXTPTR = parallel array of pointers into ISTMG character array of text
  632. C TOKEN = Current token number within statement being processed
  633. C NTOKSS = Number of tokens in statement
  634. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  635. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  636. C MAXICH = Last character used in ISTTXT array
  637. C
  638. C---------------------------------------------------------
  639. C    TOOLPACK/1    Release: 2.4
  640. C---------------------------------------------------------
  641. C
  642. C  TKLAST = LAST TOKEN NUMBER
  643. C
  644.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  645.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  646.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  647.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  648.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  649.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  650.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  651.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  652.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  653.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  654.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  655.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  656.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  657.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  658.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  659.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  660.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  661.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  662.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  663.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  664.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  665.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  666.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  667.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  668.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  669.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  670.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  671.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  672.  
  673. C---------------------------------------------------------
  674. C    TOOLPACK/1    Release: 2.3
  675. C---------------------------------------------------------
  676. C                  CONTROL VARIABLES
  677.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  678.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  679.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  680.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  681.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  682.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  683.      *         NSTMG,       NTREEG,      NTYPEG
  684.  
  685.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  686.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  687.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  688.      +          NTREEG,NTYPEG
  689.  
  690.         SAVE /CNTRLC/
  691.  
  692.  
  693.         INTEGER TEXT(134),JUNK,I,L
  694.  
  695.         INTEGER ZTOKTX,LENGTH
  696.         CHARACTER ZCITOC
  697.         EXTERNAL ZTOKTX,LENGTH,ZCITOC
  698. C
  699. C Store text of first token
  700. C
  701.  100    JUNK=ZTOKTX(TOKTYP(NTOKSS),TOKLEN(NTOKSS),
  702.      +              ISTTXT(ISTPTR(NTOKSS)),TEXT)
  703.         L=LENGTH(TEXT)
  704.         DO 200 I=1,L
  705.  200        ISTMG(NSTMG+I)=ZCITOC(TEXT(I),ISTMG(NSTMG+I))
  706.         TXTPTR(NTOKSS)=NSTMG+1
  707.         NSTMG=NSTMG+L
  708. C Dump comment buffer
  709.         CALL DMPCMS
  710. C Read next token
  711.         CALL READTK
  712. C If everything ok, continue collection
  713.         IF (.NOT.IEOFG .AND. TOKTYP(NTOKSS).NE.TZEOS) GOTO 100
  714.  
  715.         END
  716. C ----------------------------------------------------------------------
  717. C
  718. C       R E A D T K   -   Read a token
  719. C
  720.  
  721.         SUBROUTINE READTK
  722.  
  723. C---------------------------------------------------------
  724. C    TOOLPACK/1    Release: 2.3
  725. C---------------------------------------------------------
  726. C Character variables and arrays, except for dictionaries & VNAMEG
  727.         INTEGER MAXCMG
  728.         PARAMETER(MAXCMG=30)
  729.         COMMON /CHARC/ IBUFFG,ICARDG,ICOMG,ISTMG,NAMEG
  730.  
  731.         CHARACTER IBUFFG(1326),ICARDG(72),ISTMG(1326)
  732.         CHARACTER*6 NAMEG
  733.         CHARACTER*72 ICOMG(MAXCMG)
  734.  
  735.         SAVE /CHARC/
  736. C---------------------------------------------------------
  737. C    TOOLPACK/1    Release: 2.3
  738. C---------------------------------------------------------
  739. C                  LOGICAL VARIABLES
  740.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  741.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  742.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  743.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  744.      *         TREEG
  745.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  746.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  747.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  748.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  749.  
  750.         SAVE /LOGIC/
  751.  
  752. C---------------------------------------------------------
  753. C    TOOLPACK/1    Release: 2.4
  754. C---------------------------------------------------------
  755. C
  756. C  TKLAST = LAST TOKEN NUMBER
  757. C
  758.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  759.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  760.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  761.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  762.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  763.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  764.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  765.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  766.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  767.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  768.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  769.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  770.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  771.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  772.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  773.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  774.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  775.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  776.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  777.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  778.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  779.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  780.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  781.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  782.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  783.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  784.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  785.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  786.  
  787. C---------------------------------------------------------
  788. C    TOOLPACK/1    Release: 2.3
  789. C---------------------------------------------------------
  790.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  791.      +                MAXICH
  792.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  793.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  794.      +          MAXICH
  795.  
  796.         SAVE /TOKENS/
  797.  
  798. C
  799. C TOKTYP = array of token types for current statement
  800. C TOKLEN = parallel array of lengths of associated text strings
  801. C TXTPTR = parallel array of pointers into ISTMG character array of text
  802. C TOKEN = Current token number within statement being processed
  803. C NTOKSS = Number of tokens in statement
  804. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  805. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  806. C MAXICH = Last character used in ISTTXT array
  807. C
  808. C---------------------------------------------------------
  809. C    TOOLPACK/1    Release: 2.3
  810. C---------------------------------------------------------
  811.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  812.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  813.  
  814.         SAVE /IO/
  815.  
  816. C---------------------------------------------------------
  817. C    TOOLPACK/1    Release: 2.3
  818. C---------------------------------------------------------
  819. C                  CONTROL VARIABLES
  820.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  821.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  822.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  823.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  824.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  825.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  826.      *         NSTMG,       NTREEG,      NTYPEG
  827.  
  828.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  829.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  830.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  831.      +          NTREEG,NTYPEG
  832.  
  833.         SAVE /CNTRLC/
  834.  
  835. C---------------------------------------------------------
  836. C    TOOLPACK/1    Release: 2.3
  837. C---------------------------------------------------------
  838. C                  KEYWORD ID VARIABLES
  839.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  840.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  841.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  842.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  843.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  844.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  845.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  846.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  847.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  848.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  849.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  850.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  851.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  852.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  853.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  854.      *         LLINEG,      LSTMTG
  855.  
  856.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  857.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  858.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  859.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  860.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  861.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  862.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  863.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  864.         INTEGER KUFUNG,KSUBRG
  865.  
  866.         SAVE /KEYSC/
  867.  
  868.  
  869.         INTEGER STATUS,I,ISAVEL
  870.         CHARACTER*72 CARD
  871.         EQUIVALENCE (CARD,ICARDG)
  872.  
  873.         EXTERNAL ZGETTK,ZITOF
  874. C
  875.   100   CONTINUE
  876.         NTOKSS=NTOKSS+1
  877.         MAXICH=MAXICH+1
  878.         CALL ZGETTK(TOKTYP(NTOKSS),TOKLEN(NTOKSS),ISTTXT(MAXICH),TKIDES,
  879.      +              STATUS)
  880.         ISTPTR(NTOKSS)=MAXICH
  881.         MAXICH=MAXICH+TOKLEN(NTOKSS)
  882.         IEOFG=STATUS.EQ.-100 .OR. STATUS.EQ.-1 .OR.
  883.      +        TOKTYP(NTOKSS).EQ.TZEOF
  884. C Count input tokens
  885.         IF (.NOT.IEOFG) THEN
  886.             CALL COUNTS(LLINEG)
  887. C If token a comment, process separately.
  888.             IF (TOKTYP(NTOKSS).EQ.TCMMNT) THEN
  889.                 CARD=' '
  890.                 CALL ZITOF(ISTTXT(ISTPTR(NTOKSS)),1,72,CARD,.FALSE.)
  891.                 CALL COMNTS(ISAVEL)
  892. C Do not process non-assertion comments
  893.                 IF (ISAVEL.EQ.1) THEN
  894.                     MAXICH=MAXICH-TOKLEN(NTOKSS)-1
  895.                     NTOKSS=NTOKSS-1
  896.                     GOTO 100
  897.                 END IF
  898.             END IF
  899.         END IF
  900.  
  901.         END
  902. C ----------------------------------------------------------------------
  903. C
  904. C       R E A D S S   -   Input a complete source statement
  905. C
  906.  
  907.         SUBROUTINE READSS
  908.  
  909. C---------------------------------------------------------
  910. C    TOOLPACK/1    Release: 2.3
  911. C---------------------------------------------------------
  912. C                  LOGICAL VARIABLES
  913.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  914.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  915.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  916.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  917.      *         TREEG
  918.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  919.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  920.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  921.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  922.  
  923.         SAVE /LOGIC/
  924.  
  925. C---------------------------------------------------------
  926. C    TOOLPACK/1    Release: 2.3
  927. C---------------------------------------------------------
  928. C                  CONTROL VARIABLES
  929.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  930.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  931.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  932.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  933.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  934.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  935.      *         NSTMG,       NTREEG,      NTYPEG
  936.  
  937.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  938.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  939.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  940.      +          NTREEG,NTYPEG
  941.  
  942.         SAVE /CNTRLC/
  943.  
  944. C---------------------------------------------------------
  945. C    TOOLPACK/1    Release: 2.4
  946. C---------------------------------------------------------
  947. C
  948. C  TKLAST = LAST TOKEN NUMBER
  949. C
  950.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  951.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  952.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  953.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  954.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  955.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  956.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  957.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  958.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  959.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  960.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  961.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  962.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  963.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  964.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  965.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  966.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  967.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  968.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  969.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  970.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  971.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  972.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  973.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  974.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  975.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  976.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  977.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  978.  
  979. C---------------------------------------------------------
  980. C    TOOLPACK/1    Release: 2.3
  981. C---------------------------------------------------------
  982.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  983.      +                MAXICH
  984.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  985.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  986.      +          MAXICH
  987.  
  988.         SAVE /TOKENS/
  989.  
  990. C
  991. C TOKTYP = array of token types for current statement
  992. C TOKLEN = parallel array of lengths of associated text strings
  993. C TXTPTR = parallel array of pointers into ISTMG character array of text
  994. C TOKEN = Current token number within statement being processed
  995. C NTOKSS = Number of tokens in statement
  996. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  997. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  998. C MAXICH = Last character used in ISTTXT array
  999. C
  1000. C---------------------------------------------------------
  1001. C    TOOLPACK/1    Release: 2.3
  1002. C---------------------------------------------------------
  1003. C                  KEYWORD ID VARIABLES
  1004.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1005.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1006.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1007.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1008.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1009.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1010.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1011.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1012.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1013.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1014.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1015.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1016.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1017.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1018.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1019.      *         LLINEG,      LSTMTG
  1020.  
  1021.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1022.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1023.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1024.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1025.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1026.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1027.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1028.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1029.         INTEGER KUFUNG,KSUBRG
  1030.  
  1031.         SAVE /KEYSC/
  1032.  
  1033. C---------------------------------------------------------
  1034. C    TOOLPACK/1    Release: 2.3
  1035. C---------------------------------------------------------
  1036.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1037.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1038.  
  1039.         SAVE /IO/
  1040.  
  1041.  
  1042.         NSTMG = 0
  1043.         NTOKSS=0
  1044.         MAXICH=0
  1045.         CALL READTK
  1046. C Is this the first time a token will be read?
  1047.         IF (.NOT.CARD1G) THEN
  1048.             NCOMG = 0
  1049. C Source program file empty?
  1050.             IF (IEOFG) CALL ERRORS(4)
  1051.             CARD1G = .TRUE.
  1052.         ELSE IF (IEOFG) THEN
  1053. C Output the end-of-file token
  1054.             CALL ZTOKWR(TOKTYP(NTOKSS),TOKLEN(NTOKSS),
  1055.      +                  ISTTXT(ISTPTR(NTOKSS)),TKODES)
  1056.             RETURN
  1057.         END IF
  1058.   100   IF (TOKTYP(NTOKSS).EQ.TCMMNT) THEN
  1059. C Pick up an entire assertion statement
  1060.             CALL RDAS
  1061.             IF (NSTMG .NE. 0) CALL COUNTS(LASRTG)
  1062.         ELSE
  1063. C Pick up an entire normal statement
  1064.             CALL RDSS
  1065.             IF (NSTMG .NE. 0) CALL COUNTS(LSTMTG)
  1066.         END IF
  1067. C If problems during this attempt, try again.
  1068.         IF (.NOT.IEOFG .AND. NSTMG.EQ.0) GOTO 100
  1069.  
  1070.         END
  1071. C ----------------------------------------------------------------------
  1072. C
  1073. C       S E G M T S   -   Start a new segment
  1074. C
  1075.  
  1076.         SUBROUTINE SEGMTS(SFLAGA)
  1077.         LOGICAL SFLAGA
  1078.  
  1079. C---------------------------------------------------------
  1080. C    TOOLPACK/1    Release: 2.3
  1081. C---------------------------------------------------------
  1082. C                  LOGICAL VARIABLES
  1083.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1084.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1085.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1086.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1087.      *         TREEG
  1088.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1089.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1090.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1091.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1092.  
  1093.         SAVE /LOGIC/
  1094.  
  1095. C---------------------------------------------------------
  1096. C    TOOLPACK/1    Release: 2.3
  1097. C---------------------------------------------------------
  1098. C                  CONTROL VARIABLES
  1099.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1100.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1101.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1102.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1103.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1104.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1105.      *         NSTMG,       NTREEG,      NTYPEG
  1106.  
  1107.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1108.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1109.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1110.      +          NTREEG,NTYPEG
  1111.  
  1112.         SAVE /CNTRLC/
  1113.  
  1114.  
  1115.         IF (.NOT.SEGMTG) THEN
  1116. C Record previous segment activity on statement type summary file, if
  1117. C required
  1118.             IF (SFLAGA) CALL SGSUMS
  1119. C Start new segment
  1120.             NMSEG = NMSEG + 1
  1121.             SEGMTG = .TRUE.
  1122.         END IF
  1123.  
  1124.         END
  1125. C ----------------------------------------------------------------------
  1126. C
  1127. C       S F I N D T   -   Return next special token (not a name or const
  1128. C                         and skipping parenthesised fields.
  1129. C
  1130.  
  1131.         INTEGER FUNCTION SFINDT(ITOKA)
  1132.         INTEGER ITOKA
  1133.  
  1134. C---------------------------------------------------------
  1135. C    TOOLPACK/1    Release: 2.4
  1136. C---------------------------------------------------------
  1137. C
  1138. C  TKLAST = LAST TOKEN NUMBER
  1139. C
  1140.       INTEGER TZEOF ,TASSIG,TBACKS,TBLOCK,TCALL ,TCLOSE,TCOMMO,TCONTI,
  1141.      +        TDATA ,TDO   ,TDIMEN,TELSE ,TELSIF,TEND  ,TENDFI,TENDIF,
  1142.      +        TENTRY,TEQUIV,TEXTER,TFUNCT,TFORMA,TGOTO ,TIF   ,TIMPLI,
  1143.      +        TINQUI,TINTRI,TOPEN ,TPARAM,TPAUSE,TPRINT,TPROGR,TREAD ,
  1144.      +        TRETUR,TREWIN,TSAVE ,TSTOP ,TSUBRO,TTHEN ,TTO   ,TWRITE,
  1145.      +        TINTEG,TREAL ,TDOUBL,TCOMPL,TLOGIC,TCHARA,TDCMPL,TCOMMA,
  1146.      +        TEQUAL,TCOLON,TLPARN,TRPARN,TLE   ,TLT   ,TEQ   ,TNE   ,
  1147.      +        TGE   ,TGT   ,TAND  ,TOR   ,TEQV  ,TNEQV ,TNOT  ,TSTAR ,
  1148.      +        TDSTAR,TPLUS ,TMINUS,TSLASH,TCNCAT,TDCNST,TLCNST,TRCNST,
  1149.      +        TPCNST,TCCNST,THCNST,TNAME ,TFIELD,TSCALE,TZEOS ,TCMMNT,
  1150.      +        TFMTKD,TENDKD,TERRKD,TKLAST
  1151.       PARAMETER (TZEOF = 1,TASSIG= 2,TBACKS= 3,TBLOCK= 4,TCALL = 5,
  1152.      +           TCLOSE= 6,TCOMMO= 7,TCONTI= 8,TDATA = 9,TDO   =10,
  1153.      +           TDIMEN=11,TELSE =12,TELSIF=13,TEND  =14,TENDFI=15,
  1154.      +           TENDIF=16,TENTRY=17,TEQUIV=18,TEXTER=19,TFUNCT=20,
  1155.      +           TFORMA=21,TGOTO =22,TIF   =23,TIMPLI=24,TINQUI=25,
  1156.      +           TINTRI=26,TOPEN =27,TPARAM=28,TPAUSE=29,TPRINT=30,
  1157.      +           TPROGR=31,TREAD =32,TRETUR=33,TREWIN=34,TSAVE =35,
  1158.      +           TSTOP =36,TSUBRO=37,TTHEN =38,TTO   =39,TWRITE=40,
  1159.      +           TINTEG=41,TREAL =42,TDOUBL=43,TCOMPL=44,TLOGIC=45,
  1160.      +           TCHARA=46,TDCMPL=47,TCOMMA=48,TEQUAL=49,TCOLON=50,
  1161.      +           TLPARN=51,TRPARN=52,TLE   =53,TLT   =54,TEQ   =55,
  1162.      +           TNE   =56,TGE   =57,TGT   =58,TAND  =59,TOR   =60,
  1163.      +           TEQV  =61,TNEQV =62,TNOT  =63,TSTAR =64,TDSTAR=65,
  1164.      +           TPLUS =66,TMINUS=67,TSLASH=68,TCNCAT=69,TDCNST=70,
  1165.      +           TLCNST=71,TRCNST=72,TPCNST=73,TCCNST=74,THCNST=75,
  1166.      +           TNAME =76,TFIELD=77,TSCALE=78,TZEOS =79,TCMMNT=80,
  1167.      +           TFMTKD=81,TENDKD=82,TERRKD=83,TKLAST=83)
  1168.  
  1169. C---------------------------------------------------------
  1170. C    TOOLPACK/1    Release: 2.3
  1171. C---------------------------------------------------------
  1172.         COMMON/TOKENS/TOKTYP,TOKLEN,TXTPTR,TOKEN,NTOKSS,ISTTXT,ISTPTR,
  1173.      +                MAXICH
  1174.         INTEGER TOKTYP(800),TOKLEN(800),TXTPTR(800),
  1175.      +          TOKEN,NTOKSS,ISTTXT(1322+800),ISTPTR(800),
  1176.      +          MAXICH
  1177.  
  1178.         SAVE /TOKENS/
  1179.  
  1180. C
  1181. C TOKTYP = array of token types for current statement
  1182. C TOKLEN = parallel array of lengths of associated text strings
  1183. C TXTPTR = parallel array of pointers into ISTMG character array of text
  1184. C TOKEN = Current token number within statement being processed
  1185. C NTOKSS = Number of tokens in statement
  1186. C ISTTXT = IST text of token as read in before being converted by ZTOKTX
  1187. C ISTPTR = parallel array (to TOKTYP) of pointers into ISTTXT
  1188. C MAXICH = Last character used in ISTTXT array
  1189. C
  1190.  
  1191.         INTEGER TMP
  1192.  
  1193.         SFINDT=ITOKA
  1194.  100    IF (TOKTYP(SFINDT).EQ.TNAME .OR. TOKTYP(SFINDT).EQ.TDCNST .OR.
  1195.      +      TOKTYP(SFINDT).EQ.TRCNST .OR. TOKTYP(SFINDT).EQ.TPCNST .OR.
  1196.      +      TOKTYP(SFINDT).EQ.TCCNST .OR. TOKTYP(SFINDT).EQ.THCNST .OR.
  1197.      +      TOKTYP(SFINDT).EQ.TLCNST) THEN
  1198.             SFINDT=SFINDT+1
  1199.             GOTO 100
  1200.         ELSE IF (TOKTYP(SFINDT).EQ.TLPARN) THEN
  1201.             TMP=SFINDT
  1202.             CALL BALPRT(TMP,SFINDT)
  1203.             SFINDT=SFINDT+1
  1204.             GOTO 100
  1205.         END IF
  1206.  
  1207.         END
  1208. C ----------------------------------------------------------------------
  1209. C
  1210. C       S G S U M S   -   Output segment record to segment type summary
  1211. C                         file
  1212. C
  1213.  
  1214.         SUBROUTINE SGSUMS
  1215.  
  1216. C---------------------------------------------------------
  1217. C    TOOLPACK/1    Release: 2.3
  1218. C---------------------------------------------------------
  1219. C                  CONTROL VARIABLES
  1220.       COMMON / CNTRLC  /    IERRG,       IFTYPG,      ITYPEG,
  1221.      *         IUNITG,      JERRG,       KERRG,       LABFLG,
  1222.      *         LINEG,       LTYPEG,      NBUFFG,      NTOKG,
  1223.      *         NTOK2G,      NTOK3G,      NTOK4G,      NCOMG,
  1224.      *         NCRTNG,      NDDICG,      NEDICG,      NLABG,
  1225.      *         NMASRG,      NMSEG,       NRDICG,      NRTNG,
  1226.      *         NSTMG,       NTREEG,      NTYPEG
  1227.  
  1228.         INTEGER IERRG,IFTYPG,ITYPEG,IUNITG,JERRG,KERRG,LABFLG,LINEG,
  1229.      +          LTYPEG,NBUFFG,NTOKG,NTOK2G,NTOK3G,NTOK4G,NCOMG,NCRTNG,
  1230.      +          NDDICG,NEDICG,NLABG,NMASRG,NMSEG,NRDICG,NRTNG,NSTMG,
  1231.      +          NTREEG,NTYPEG
  1232.  
  1233.         SAVE /CNTRLC/
  1234.  
  1235. C---------------------------------------------------------
  1236. C    TOOLPACK/1    Release: 2.3
  1237. C---------------------------------------------------------
  1238. C                  LOGICAL VARIABLES
  1239.       COMMON / LOGIC   /    ARITHG,      ASSRTG,      BLKDTG,
  1240.      *         CARD1G,      CGOTOG,      ENTRYG,      EXECG,
  1241.      *         HISTG,       IEOFG,       IFDOG,       INSRTG,
  1242.      *         MAING,       SEGMTG,      STOPG,       TRACEG,
  1243.      *         TREEG
  1244.       LOGICAL  ARITHG,      ASSRTG,      BLKDTG,      CARD1G,
  1245.      *         CGOTOG,      ENTRYG,      EXECG,       HISTG,
  1246.      *         IEOFG,       IFDOG,       INSRTG,      MAING,
  1247.      *         SEGMTG,      STOPG,       TRACEG,      TREEG
  1248.  
  1249.         SAVE /LOGIC/
  1250.  
  1251. C---------------------------------------------------------
  1252. C    TOOLPACK/1    Release: 2.3
  1253. C---------------------------------------------------------
  1254. C                  MAIN INTEGER STORAGE ARRAYS
  1255. C MAXLBG = Maximum number of DO statement labels per routine
  1256.         INTEGER MAXLBG
  1257.         PARAMETER(MAXLBG=100)
  1258.         COMMON / WORKC   /  IABEG(201),  ICRTNG(200), IPCNTG(75),
  1259.      *         IRCNTG(75),  ISBEG(201),  ISCNTG(75),  INSTG(250),
  1260.      *         KEXECG(75),  LABG(2,MAXLBG), KTOKG(81)
  1261.         INTEGER IABEG,ICRTNG,IPCNTG,IRCNTG,ISBEG,ISCNTG,INSTG,
  1262.      +          KEXECG,LABG,KTOKG
  1263.         SAVE /WORKC/
  1264. C---------------------------------------------------------
  1265. C    TOOLPACK/1    Release: 2.3
  1266. C---------------------------------------------------------
  1267.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1268.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1269.  
  1270.         SAVE /IO/
  1271.  
  1272.  
  1273.         INTEGER IOUTL(150),NUML,L,NPAIRL
  1274.  
  1275.         EXTERNAL PUTCH
  1276.  
  1277. C Determine which executable statement types active
  1278.         NUML = 0
  1279.         DO 110 L=1,NTYPEG
  1280.             IF (ISCNTG(L) .EQ. 0) GOTO 110
  1281.             IF (KEXECG(L) .EQ. 0) GOTO 100
  1282. C This type was both executable and active in this segment
  1283.             NUML = NUML + 2
  1284.             IOUTL(NUML-1) = L
  1285.             IOUTL(NUML) = ISCNTG(L)
  1286.  100        ISCNTG(L) = 0
  1287.  110    CONTINUE
  1288.  
  1289.         IF (BLKDTG) RETURN
  1290. C Ensure at least one record output
  1291.         IF (NUML .GT. 0) THEN
  1292.             NPAIRL = NUML / 2
  1293.         ELSE
  1294.             NUML = 2
  1295.             NPAIRL = 1
  1296.             IOUTL(1) = 1
  1297.             IOUTL(2) = 0
  1298.         END IF
  1299. C Output statistics record for segment to statement type summary file
  1300.         CALL OUTZFI(NPAIRL,2,IODSTS)
  1301.         DO 115 L=0,NUML-2,2
  1302.             CALL OUTZFI(IOUTL(L+1),2,IODSTS)
  1303.             CALL OUTZFI(IOUTL(L+2),3,IODSTS)
  1304.  115    CONTINUE
  1305.         CALL PUTCH(10,IODSTS)
  1306.  
  1307.         END
  1308. C ----------------------------------------------------------------------
  1309. C
  1310. C       S U M S   -   Print statement type summary report
  1311. C
  1312.  
  1313.         SUBROUTINE SUMS(IOUTA)
  1314.         INTEGER IOUTA(*)
  1315.  
  1316. C---------------------------------------------------------
  1317. C    TOOLPACK/1    Release: 2.3
  1318. C---------------------------------------------------------
  1319. C                  KEYWORD ID VARIABLES
  1320.       COMMON / KEYSC   /    KAGOG,       KAIFG,       KASMTG,
  1321.      *         KASSNG,      KBACKG,      KBIFG,       KBLOKG,
  1322.      *         KCALLG,      KCFUNG,      KCGOG,       KCHARG,
  1323.      *         KCLOSG,      KCMPXG,      KCOMNG,      KCONTG,
  1324.      *         KDATAG,      KDBLEG,      KDFUNG,      KDIMNG,
  1325.      *         KDOG,        KELSEG,      KELSFG,      KENDFG,
  1326.      *         KENDG,       KENDIG,      KEQIVG,      KEXTLG,
  1327.      *         KFORMG,      KIFUNG,      KIMPLG,      KINQRG,
  1328.      *         KINSCG,      KINTEG,      KLFUNG,      KLIFG,
  1329.      *         KLOGCG,      KNONEG,      KNTRYG,      KOPENG,
  1330.      *         KPARAG,      KPAUSG,      KPRNTG,      KPROGG,
  1331.      *         KREADG,      KREALG,      KRETNG,      KRFUNG,
  1332.      *         KSAVEG,      KSFUNG,      KSTOPG,      KSUBRG,
  1333.      *         KUFUNG,      KUGOG,       KWINDG,      KWRITG,
  1334.      *         KXFUNG,      LASRTG,      LCMNTG,      LERRG,
  1335.      *         LLINEG,      LSTMTG
  1336.  
  1337.         INTEGER KAGOG,KAIFG,KASMTG,KASSNG,KBACKG,KBIFG,KBLOKG,KCALLG,
  1338.      +          KCFUNG,KCGOG,KCHARG,KCLOSG,KCMPXG,KCOMNG,KCONTG,KDATAG,
  1339.      +          KDBLEG,KDFUNG,KDIMNG,KDOG,KELSEG,KELSFG,KENDFG,KENDG,
  1340.      +          KENDIG,KEQIVG,KEXTLG,KFORMG,KIFUNG,KIMPLG,KINQRG,KINSCG,
  1341.      +          KINTEG,KLFUNG,KLIFG,KLOGCG,KNONEG,KNTRYG,KOPENG,KPARAG,
  1342.      +          KPAUSG,KPRNTG,KPROGG,KREADG,KREALG,KRETNG,KRFUNG,KSAVEG,
  1343.      +          KSFUNG,KSTOPG,KSUNRG,KUUNG,KUGOG,KWINDG,KWRITG,KXFUNG,
  1344.      +          LASRTG,LCMNTG,LERRG,LLINEG,LSTMTG
  1345.         INTEGER KUFUNG,KSUBRG
  1346.  
  1347.         SAVE /KEYSC/
  1348.  
  1349. C---------------------------------------------------------
  1350. C    TOOLPACK/1    Release: 2.3
  1351. C---------------------------------------------------------
  1352.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1353.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1354.  
  1355.         SAVE /IO/
  1356.  
  1357.  
  1358.         INTEGER IFL,IFUNCL,IGOTOL
  1359.  
  1360.         EXTERNAL ZPTINT,ZOBLNK,PUTCH,ZCHOUT,ZMESS
  1361.  
  1362.       IFL     = IOUTA(KAIFG)  + IOUTA(KBIFG)  + IOUTA(KLIFG)
  1363.       IFUNCL  = IOUTA(KCFUNG) + IOUTA(KXFUNG) + IOUTA(KDFUNG) +
  1364.      +          IOUTA(KIFUNG) + IOUTA(KLFUNG) + IOUTA(KRFUNG) +
  1365.      +          IOUTA(KUFUNG)
  1366.       IGOTOL  = IOUTA(KAGOG)  + IOUTA(KCGOG)  + IOUTA(KUGOG)
  1367.  
  1368.         CALL ZOBLNK(28,IODSUM)
  1369.         CALL ZMESS('STATEMENT TYPE SUMMARY.',IODSUM)
  1370.         CALL PUTCH(10, IODSUM)
  1371.         CALL ZOBLNK(30,IODSUM)
  1372.         CALL ZCHOUT('ASSERTIONS .',IODSUM)
  1373.         CALL ZPTINT(IOUTA(LASRTG),5,IODSUM)
  1374.         CALL PUTCH(10,IODSUM)
  1375.         CALL ZOBLNK(30,IODSUM)
  1376.         CALL ZCHOUT('COMMENTS   .',IODSUM)
  1377.         CALL ZPTINT(IOUTA(LCMNTG),5,IODSUM)
  1378.         CALL PUTCH(10,IODSUM)
  1379.         CALL ZOBLNK(30,IODSUM)
  1380.         CALL ZCHOUT('ERRORS     .',IODSUM)
  1381.         CALL ZPTINT(IOUTA(LERRG),5,IODSUM)
  1382.         CALL PUTCH(10,IODSUM)
  1383.         CALL ZOBLNK(30,IODSUM)
  1384.         CALL ZCHOUT('TOKENS     .',IODSUM)
  1385.         CALL ZPTINT(IOUTA(LLINEG),5,IODSUM)
  1386.         CALL PUTCH(10,IODSUM)
  1387.         CALL ZOBLNK(30,IODSUM)
  1388.         CALL ZCHOUT('STATEMENTS .',IODSUM)
  1389.         CALL ZPTINT(IOUTA(LSTMTG),5,IODSUM)
  1390.         CALL PUTCH(10,IODSUM)
  1391.         CALL PUTCH(10,IODSUM)
  1392.  
  1393.         CALL OUTFM1(IOUTA(KASSNG),IGOTOL,'ASSIGN','GO TO')
  1394.         CALL OUTFM1(IOUTA(KBACKG),IOUTA(KAGOG),'BACKSPACE',
  1395.      +              '  (ASSIGNED)')
  1396.         CALL OUTFM1(IOUTA(KBLOKG),IOUTA(KCGOG),'BLOCK DATA',
  1397.      +              '  (COMPUTED)')
  1398.         CALL OUTFM1(IOUTA(KCALLG),IOUTA(KUGOG),'CALL',
  1399.      +              '  (UNCONDITIONAL)')
  1400.         CALL OUTFM1(IOUTA(KCHARG),IFL,'CHARACTER','IF')
  1401.         CALL OUTFM1(IOUTA(KCLOSG),IOUTA(KAIFG),'CLOSE','  (ARITHMETIC)')
  1402.         CALL OUTFM1(IOUTA(KCOMNG),IOUTA(KBIFG),'COMMON','  (BLOCK)')
  1403.         CALL OUTFM1(IOUTA(KCMPXG),IOUTA(KLIFG),'COMPLEX','  (LOGICAL)')
  1404.         CALL OUTFM1(IOUTA(KCONTG),IOUTA(KIMPLG),'CONTINUE','IMPLICIT')
  1405.         CALL OUTFM1(IOUTA(KDATAG),IOUTA(KINQRG),'DATA','INQUIRE')
  1406.         CALL OUTFM1(IOUTA(KDIMNG),IOUTA(KINTEG),'DIMENSION','INTEGER')
  1407.         CALL OUTFM1(IOUTA(KDBLEG),IOUTA(KINSCG),'DOUBLE PRECISION',
  1408.      +                                                      'INTRINSIC')
  1409.         CALL OUTFM1(IOUTA(KDOG),IOUTA(KLOGCG),'DO','LOGICAL')
  1410.         CALL OUTFM1(IOUTA(KELSFG),IOUTA(KOPENG),'ELSE IF','OPEN')
  1411.         CALL OUTFM1(IOUTA(KELSEG),IOUTA(KPARAG),'ELSE','PARAMETER')
  1412.         CALL OUTFM1(IOUTA(KENDFG),IOUTA(KPAUSG),'ENDFILE','PAUSE')
  1413.         CALL OUTFM1(IOUTA(KENDIG),IOUTA(KPRNTG),'END IF','PRINT')
  1414.         CALL OUTFM1(IOUTA(KENDG),IOUTA(KPROGG),'END','PROGRAM')
  1415.         CALL OUTFM1(IOUTA(KNTRYG),IOUTA(KREADG),'ENTRY','READ')
  1416.         CALL OUTFM1(IOUTA(KEQIVG),IOUTA(KREALG),'EQUIVALENCE','REAL')
  1417.         CALL OUTFM1(IOUTA(KEXTLG),IOUTA(KRETNG),'EXTERNAL','RETURN')
  1418.         CALL OUTFM1(IOUTA(KFORMG),IOUTA(KWINDG),'FORMAT','REWIND')
  1419.         CALL OUTFM1(IFUNCL,IOUTA(KSAVEG),'FUNCTION','SAVE')
  1420.         CALL OUTFM1(IOUTA(KCFUNG),IOUTA(KSTOPG),'  CHARACTER','STOP')
  1421.         CALL OUTFM1(IOUTA(KXFUNG),IOUTA(KSUBRG),'  COMPLEX',
  1422.      +              'SUBROUTINE')
  1423.         CALL OUTFM1(IOUTA(KDFUNG),IOUTA(KWRITG),'  DOUBLE PRECISION',
  1424.      +              'WRITE')
  1425.         CALL OUTFM1(IOUTA(KIFUNG),IOUTA(KASMTG),'  INTEGER',
  1426.      +              '(ASSIGNMENT STATEMENTS)')
  1427.         CALL OUTFM1(IOUTA(KLFUNG),IOUTA(KSFUNG),'  LOGICAL',
  1428.      +              '(STATEMENT FUNCTIONS)')
  1429.         CALL OUTFM1(IOUTA(KRFUNG),IOUTA(KNONEG),'  REAL',
  1430.      +              '(UNRECOGNIZED STATEMENTS)')
  1431.         CALL OUTFM1(IOUTA(KUFUNG),0,'  UNTYPED','-')
  1432.  
  1433.         END
  1434. C ----------------------------------------------------------------------
  1435. C
  1436. C       O U T F M 1   -   Output things according to the formats used in
  1437. C                         the routine SUMS.
  1438. C
  1439.  
  1440.         SUBROUTINE OUTFM1(VAL1,VAL2,STR1,STR2)
  1441.         INTEGER VAL1,VAL2
  1442.         CHARACTER*(*) STR1,STR2
  1443.  
  1444. C---------------------------------------------------------
  1445. C    TOOLPACK/1    Release: 2.3
  1446. C---------------------------------------------------------
  1447.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1448.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1449.  
  1450.         SAVE /IO/
  1451.  
  1452.  
  1453.         CHARACTER*28 STRING
  1454.  
  1455.         STRING=STR1
  1456.         CALL ZCHOUT('  '//STRING,IODSUM)
  1457.         CALL ZPTINT(VAL1,5,IODSUM)
  1458.         STRING=STR2
  1459.         CALL ZCHOUT('          '//STRING,IODSUM)
  1460.         CALL ZPTINT(VAL2,5,IODSUM)
  1461.         CALL PUTCH(10,IODSUM)
  1462.  
  1463.         END
  1464. C ----------------------------------------------------------------------
  1465. C
  1466. C       T C O M N S   -   Insert trace common block instrumentation
  1467. C
  1468.  
  1469.         SUBROUTINE TCOMNS
  1470.  
  1471. C---------------------------------------------------------
  1472. C    TOOLPACK/1    Release: 2.3
  1473. C---------------------------------------------------------
  1474. C Option Settings
  1475.         COMMON /OPTSC/ INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,
  1476.      +                 MTREQG,TIEG,ITRUNG
  1477.  
  1478.         INTEGER INHSTG,INTRAG,ITHSTG,ITLSTG,ITTRAG,MCIRCG,MTREQG,
  1479.      +          ITRUNG
  1480.         LOGICAL TIEG
  1481.  
  1482.         SAVE /OPTSC/
  1483.  
  1484. C---------------------------------------------------------
  1485. C    TOOLPACK/1    Release: 2.3
  1486. C---------------------------------------------------------
  1487.         COMMON/IO/IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1488.         INTEGER IODINS,IODSTS,IODSUM,IODSCR,TKIDES,TKODES
  1489.  
  1490.         SAVE /IO/
  1491.  
  1492. C---------------------------------------------------------
  1493. C    TOOLPACK/1    Release: 2.3
  1494. C---------------------------------------------------------
  1495.         COMMON/ANVNAM/VNAMEG
  1496.         CHARACTER*5 VNAMEG
  1497.         SAVE/ANVNAM/
  1498.  
  1499.         EXTERNAL ZMESS,ZCHOUT,ZPTINT
  1500.  
  1501.         CALL ZMESS('      COMMON/D'//VNAMEG//'/ISEG,JVAL,KVAL,NREQ,'//
  1502.      +              'LPRE,LPOST,LRANGE,IFLAG,ITTRA',IODINS)
  1503.         CALL ZCHOUT('      INTEGER ISEG(',IODINS)
  1504.         CALL ZPTINT(MTREQG,4,IODINS)
  1505.         CALL ZCHOUT('),JVAL(',IODINS)
  1506.         CALL ZPTINT(MTREQG,4,IODINS)
  1507.         CALL ZCHOUT('),KVAL(',IODINS)
  1508.         CALL ZPTINT(MTREQG,4,IODINS)
  1509.         CALL ZMESS('),NREQ,LPRE,LPOST,LRANGE,',IODINS)
  1510.         CALL ZMESS('     +IFLAG,ITTRA',IODINS)
  1511.         CALL ZMESS('      SAVE/D'//VNAMEG//'/',IODINS)
  1512.  
  1513.         END
  1514.